Ian & Stuart's Australian Mac 1993 September/September 93.iso/Archives/Games/Strategy/Puzzle/GameMaster/GM Dev Kit/Rulebook Sources/Chess/ChessMoves.p

Text File | 1991-12-05 | 12.7 KB | 484 lines | [TEXT/PJMM]

unit ChessMoves;

{ ©1991 Quinn "The Eskimo" }

interface

    uses
        ChessTypes, Debugs, Failure, {}
        ChessSubs, ChessBoardSubs;

    function CheckCheck (var board: boardType; at: boardCoord): boolean;
    procedure CalculateValidSet (var board: boardType; var state: chessState; from: boardCoord; {}
                                    var valid: boardSet; var valid_count: integer);
    function NoValidMoves (player: playerType; var state: chessState; var board: boardType): boolean;

    procedure InitState (var state: chessState);
    procedure UpdateState (var state: chessState; var board: boardType; from: boardCoord; toc: boardCoord);

implementation

    const
        kExBoardXMax = kBoardXMax + 2;
        kExBoardYMax = kBoardYMax + 2;
    type
        exBoardXNdx = -2..kExBoardXMax;
        exBoardYNdx = -2..kExBoardYMax;

    function OnBoard (x: exBoardXNdx; y: exBoardYNdx): boolean;
    begin
        OnBoard := (x >= 0) and (x <= kBoardXMax) and (y >= 0) and (y <= kBoardYMax);
    end; { OnBoard }

    function CheckCheck (var board: boardType; at: boardCoord): boolean;

        function Scan (dx, dy: integer; dangerous: pieceSet): boolean;
            var
                nx: exBoardXNdx;
                ny: exBoardYNdx;
                leave: boolean;
        begin
            Scan := false;
            nx := at.x + dx;
            ny := at.y + dy;
            leave := false;
            while OnBoard(nx, ny) and not leave do begin
                if board[nx, ny].occupant = Oempty then begin
                    nx := nx + dx;
                    ny := ny + dy;
                end
                else if board[nx, ny].occupant in dangerous then begin
                    leave := true;
                    Scan := true;
                end
                else begin
                    leave := true;
                end; { if }
            end; { while }
        end; { Scan }

        function Test (x: exBoardXNdx; y: exBoardYNdx; piece: pieceType): boolean;
        begin
            Test := false;
            if OnBoard(x, y) then begin
                if board[x, y].occupant = piece then begin
                    Test := true;
                end; { if }
            end; { if }
        end; { Test }

        function DoIt (queen, king, bishop, knight, rook, pawn: pieceType; dy: integer): boolean;
            var
                incheck: boolean;
                diags, squares: pieceSet;
        begin
            incheck := false;
            if not incheck then
                incheck := Test(at.x + 1, at.y + dy, pawn);
            if not incheck then
                incheck := Test(at.x - 1, at.y + dy, pawn);

            if not incheck then
                incheck := Test(at.x + 1, at.y + 2, knight);
            if not incheck then
                incheck := Test(at.x + 1, at.y - 2, knight);
            if not incheck then
                incheck := Test(at.x + 2, at.y + 1, knight);
            if not incheck then
                incheck := Test(at.x + 2, at.y - 1, knight);
            if not incheck then
                incheck := Test(at.x - 1, at.y + 2, knight);
            if not incheck then
                incheck := Test(at.x - 1, at.y - 2, knight);
            if not incheck then
                incheck := Test(at.x - 2, at.y + 1, knight);
            if not incheck then
                incheck := Test(at.x - 2, at.y - 1, knight);

            if not incheck then
                incheck := Test(at.x + 1, at.y + 1, king);
            if not incheck then
                incheck := Test(at.x + 1, at.y, king);
            if not incheck then
                incheck := Test(at.x + 1, at.y - 1, king);
            if not incheck then
                incheck := Test(at.x, at.y + 1, king);
            if not incheck then
                incheck := Test(at.x, at.y - 1, king);
            if not incheck then
                incheck := Test(at.x - 1, at.y + 1, king);
            if not incheck then
                incheck := Test(at.x - 1, at.y, king);
            if not incheck then
                incheck := Test(at.x - 1, at.y - 1, king);

            if not incheck then begin
                diags := [queen, bishop];
                squares := [queen, rook];
                incheck := Scan(1, 0, squares);
                if not incheck then
                    incheck := Scan(-1, 0, squares);
                if not incheck then
                    incheck := Scan(0, 1, squares);
                if not incheck then
                    incheck := Scan(0, -1, squares);
                if not incheck then
                    incheck := Scan(1, 1, diags);
                if not incheck then
                    incheck := Scan(-1, 1, diags);
                if not incheck then
                    incheck := Scan(1, -1, diags);
                if not incheck then
                    incheck := Scan(-1, -1, diags);
            end; { if }

            DoIt := incheck;
        end; { DoIt }

    begin
        if board[at.x, at.y].occupant = OkingW then begin
            CheckCheck := DoIt(OqueenB, OkingB, ObishopB, OknightB, OrookB, OpawnB, -1);
        end
        else if board[at.x, at.y].occupant = OkingB then begin
            CheckCheck := Doit(OqueenW, OkingW, ObishopW, OknightW, OrookW, OpawnW, 1);
        end
        else begin
            Failure('CheckCheck on not king');
        end; { if }
    end; { CheckCheck }

    procedure CalculateValidSet (var board: boardType; var state: chessState; from: boardCoord; {}
                                    var valid: boardSet; var valid_count: integer);
        var
            occ: pieceType;
            king: boardCoord;
            myking: pieceType;
            player: playerType;

        function CellEmpty (x: boardXNdx; y: boardYNdx): boolean;
        begin
            CellEmpty := board[x, y].occupant = Oempty;
        end; { CellEmpty }

        function CellOpposed (x: boardXNdx; y: boardYNdx): boolean;
        begin
            CellOpposed := PieceInMyTeam(Opposite(player), board[x, y].occupant);
        end; { CellOpposed }

        function CanMove (x: exBoardXNdx; y: exBoardXNdx): boolean;
        begin
            CanMove := false;
            if OnBoard(x, y) then begin
                CanMove := CellEmpty(x, y) or CellOpposed(x, y);
            end; { if }
        end; { CanMove }

        procedure AddCell (x: boardXNdx; y: boardXNdx);
            var
                oldsrc, olddest: pieceType;
        begin
            oldsrc := board[from.x, from.y].occupant;
            olddest := board[x, y].occupant;
            if oldsrc = myking then begin
                king.x := x;
                king.y := y;
            end; { if }
            board[from.x, from.y].occupant := Oempty;
            board[x, y].occupant := oldsrc;
            if not CheckCheck(board, king) then begin
                valid[x, y] := true;
                valid_count := valid_count + 1;
            end; { if }
            board[from.x, from.y].occupant := oldsrc;
            if oldsrc = myking then begin
                king := from;
            end; { if }
            board[x, y].occupant := olddest;
        end; { AddCell }

        procedure AddIfCanMove (x: exBoardXNdx; y: exBoardXNdx);
        begin
            if CanMove(x, y) then begin
                AddCell(x, y);
            end; { if }
        end; { AddIfCanMove }

        procedure AddIfCanTake (x: exBoardXNdx; y: exBoardYNdx);
        begin
            if OnBoard(x, y) then begin
                if CellOpposed(x, y) then begin
                    AddCell(x, y);
                end; { if }
            end; { if }
        end; { AddifCanTake }

        procedure AddIfCellEmpty (x: exBoardXNdx; y: exBoardYNdx);
        begin
            if OnBoard(x, y) then begin
                if CellEmpty(x, y) then begin
                    AddCell(x, y);
                end; { if }
            end; { if }
        end; { AddIfCellEmpty }

        procedure AddLine (dx, dy: integer);
            var
                nx: exBoardXNdx;
                ny: exBoardYNdx;
                leave: boolean;
        begin
            nx := from.x + dx;
            ny := from.y + dy;
            leave := false;
            while OnBoard(nx, ny) and not leave do begin
                if CellEmpty(nx, ny) then begin
                    AddCell(nx, ny);
                    nx := nx + dx;
                    ny := ny + dy;
                end
                else if CellOpposed(nx, ny) then begin
                    AddCell(nx, ny);
                    leave := true;
                end
                else begin
                    leave := true; { Cell occupied by friendly forces }
                end; { if }
            end; { while }
        end; { AddLine }

        procedure DoPawn;
            var
                dy, dx: integer;
                base_row: boardYNdx;
        begin
            base_row := PawnBaseRow(player);
            dy := Pawn_dy(player);
            AddIfCanTake(from.x - 1, from.y + dy);
            AddIfCanTake(from.x + 1, from.y + dy);
            if OnBoard(from.x, from.y + dy) then begin
                if CellEmpty(from.x, from.y + dy) then begin
                    AddCell(from.x, from.y + dy);
                    if from.y = base_row then begin
                        AddIfCellEmpty(from.x, from.y + 2 * dy);
                    end; { if }
                end; { if }
            end; { if }
{ Handle the case where pawns can take other pawns that skipped passed them using the }
{ special case two moves in one from the start position }
{ This has a wonderful name that I dont know!  [AJW] seems to think its called en-passent }
            with state[Opposite(player)] do begin
                if canevilpawn then begin
                    if (evilpawn.y = from.y) and (abs(evilpawn.x - from.x) <= 1) then begin
                        if evilpawn.x < from.x then begin
                            dx := -1;
                        end
                        else begin
                            dx := 1;
                        end; { if }
                        AddCell(from.x + dx, from.y + dy);
                    end; { if }
                end; { if }
            end; { with }
        end; { DoPawn }

        procedure DoRook;
        begin
            AddLine(-1, 0);
            AddLine(0, -1);
            AddLine(1, 0);
            AddLine(0, 1);
        end; { DoRook }

        procedure DoKnight;
        begin
            AddIfCanMove(from.x + 1, from.y + 2);
            AddIfCanMove(from.x + 1, from.y - 2);
            AddIfCanMove(from.x + 2, from.y + 1);
            AddIfCanMove(from.x + 2, from.y - 1);
            AddIfCanMove(from.x - 1, from.y + 2);
            AddIfCanMove(from.x - 1, from.y - 2);
            AddIfCanMove(from.x - 2, from.y + 1);
            AddIfCanMove(from.x - 2, from.y - 1);
        end; { DoKnight }

        procedure DoBishop;
        begin
            AddLine(1, 1);
            AddLine(-1, 1);
            AddLine(1, -1);
            AddLine(-1, -1);
        end; { DoBishop }

        procedure DoKing;

            function ThroughCheck (which: boardCoord): boolean;
            begin
{ Swap the king and the whichx,whichy position to test whether the king is moving through check}
{ I dont want to use the code in AddCell because of its evil state changes }
{ We know that which,whichy starts empty because of the check above }
                board[which.x, which.y].occupant := board[king.x, king.y].occupant;
                board[king.x, king.y].occupant := Oempty;
                ThroughCheck := CheckCheck(board, which);
                board[king.x, king.y].occupant := board[which.x, which.y].occupant;
                board[which.x, which.y].occupant := Oempty;
            end; { ThroughCheck }

            var
                test: boardCoord;
        begin
            AddifCanMove(from.x + 1, from.y + 1);
            AddifCanMove(from.x + 1, from.y);
            AddifCanMove(from.x + 1, from.y - 1);
            AddifCanMove(from.x, from.y + 1);
            AddifCanMove(from.x, from.y - 1);
            AddifCanMove(from.x - 1, from.y + 1);
            AddifCanMove(from.x - 1, from.y);
            AddifCanMove(from.x - 1, from.y - 1);
            test.y := BaseRow(player);
            if state[player].cancastleleft then begin
                if CellEmpty(1, test.y) and CellEmpty(2, test.y) and CellEmpty(3, test.y) then begin
                    if not CheckCheck(board, king) then begin
                        test.x := 3;
                        if not ThroughCheck(test) then begin
                            AddCell(2, test.y);
                        end; { if }
                    end; { if }
                end; { if }
            end; { if }
            if state[player].cancastleright then begin
                if CellEmpty(5, test.y) and CellEmpty(6, test.y) then begin
                    if not CheckCheck(board, king) then begin
                        test.x := 5;
                        if not ThroughCheck(test) then begin
                            AddCell(6, test.y);
                        end; { if }
                    end; { if }
                end; { if }
            end; { if }
        end; { DoKing }

        procedure DoQueen;
        begin
            AddLine(1, 0);
            AddLine(-1, 0);
            AddLine(0, 1);
            AddLine(0, -1);
            AddLine(1, 1);
            AddLine(-1, 1);
            AddLine(1, -1);
            AddLine(-1, -1);
        end; { DoQueen }

    begin
        occ := board[from.x, from.y].occupant;
        player := PieceToPlayer(occ);
        myking := PlayerToKing(player);
        ClearBoardSet(valid);
        if not FindPiece(myking, board, king) then begin
            Failure('King not found');
        end; { if }
        valid_count := 0;
        case occ of
            OpawnB, OpawnW:
                DoPawn;
            OrookB, OrookW:
                DoRook;
            OknightB, OknightW:
                DoKnight;
            ObishopB, ObishopW:
                DoBishop;
            OkingB, OkingW:
                DoKing;
            OqueenB, OqueenW:
                DoQueen;
            otherwise
                Failure('case error');
        end; { case }
    end; { CalculateValidSet }

    function NoValidMoves (player: playerType; var state: chessState; var board: boardType): boolean;
        var
            x: boardXNdx;
            y: boardYNdx;
            pos: boardCoord;
            valid: boardSet;
            count: integer;
    begin
        for x := 0 to kBoardXMax do begin
            for y := 0 to kBoardYMax do begin
                if PieceInMyTeam(player, board[x, y].occupant) then begin
                    pos.x := x;
                    pos.y := y;
                    CalculateValidSet(board, state, pos, valid, count);
                    if count > 0 then begin
                        NoValidMoves := false;
                        exit(NoValidMoves);
                    end; { if }
                end; { if }
            end; { for }
        end; { for }
        NoValidMoves := true;
    end; { NoValidMoves }

    procedure InitState (var state: chessState);
        procedure InitOne (p: playerType);
        begin
            state[p].cancastleleft := true;
            state[p].cancastleright := true;
            state[p].canevilpawn := false;
            state[p].evilpawn.x := 0;
            state[p].evilpawn.y := 0;
        end; { InitOne }
    begin
        InitOne(Pblack);
        InitOne(Pwhite);
    end; { InitState }

    procedure UpdateState (var state: chessState; var board: boardType; from: boardCoord; toc: boardCoord);
        var
            occ: pieceType;
            player: playerType;

        procedure UpdateForPawn;
        begin
            if abs(from.y - toc.y) > 1 then begin
                state[player].canevilpawn := true;
                state[player].evilpawn := toc;
            end; { if }
        end; { UpdateForPawn }

        procedure UpdateForRook;
            var
                y: boardYNdx;
        begin
            y := BaseRow(player);
            if from.x = 0 then begin
                if from.y = y then begin
                    state[player].cancastleleft := false;
                end; { if }
            end; { if }
            if from.x = kBoardXMax then begin
                if from.y = y then begin
                    state[player].cancastleright := false;
                end; { if }
            end; { if }
        end; { UpdateForRook }

    begin
        state[Pblack].canevilpawn := false;
        state[Pwhite].canevilpawn := false;
        occ := board[from.x, from.y].occupant;
        player := PieceToPlayer(occ);
        case occ of
            OpawnB, OpawnW:
                UpdateForPawn;
            OrookB, OrookW:
                UpdateForRook;
            OkingB, OkingW:  begin
                state[player].cancastleleft := false;
                state[player].cancastleright := false;
            end;
        end; { case }
    end; { UpdateState }

end. { ChessMoves }